home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Applications / Moscow ML 1.31 / source code / mosml / src / mosmllib / StringCvt.sml < prev    next >
Encoding:
Text File  |  1996-07-03  |  3.8 KB  |  133 lines  |  [TEXT/R*ch]
  1. (* StringCvt -- new basis 1995-04-06 *)
  2.  
  3. local
  4.     prim_val sub_     : string -> int -> char  = 2 "get_nth_char";
  5.     prim_val fromchr_ : char -> string         = 1 "sml_makestring_of_char";
  6.     prim_val fromstr_ : string -> string       = 1 "sml_makestring_of_string";
  7.  
  8.     fun decval c = Char.ord c - 48;
  9.     fun getndig getc 0 res src = SOME (res, src)
  10.       | getndig getc n res src = 
  11.     case getc src of
  12.         NONE           => NONE
  13.       | SOME (c, rest) => 
  14.         if Char.isDigit c then 
  15.             getndig getc (n-1) (10 * res + decval c) rest
  16.         else NONE;
  17. in
  18.  
  19. datatype radix = BIN | OCT | DEC | HEX;
  20. datatype realfmt = 
  21.     SCI of int option    (* scientific,  arg = # dec. digits, dflt=6 *)
  22.   | FIX of int option   (* fixed-point, arg = # dec. digits, dflt=6 *)
  23.   | GEN of int option     (* auto choice of the above,                *)
  24.                         (* arg = # significant digits, dflt=12      *)
  25.  
  26. type 'stream accessor = {getc : 'stream -> (char * 'stream) option}
  27. type ('stream, 'result) converter = 
  28.      'stream accessor -> 'stream -> ('result * 'stream) option
  29.  
  30. fun scanString scan s =
  31.     let val len = size s
  32.     fun getc i = if i >= len then NONE 
  33.              else SOME (sub_ s i, i+1)
  34.     in case scan {getc=getc} 0 of
  35.     NONE          => NONE
  36.       | SOME (res, _) => SOME res
  37.     end
  38.  
  39. fun skipWS {getc} source = 
  40.     case getc source of 
  41.     NONE           => source
  42.       | SOME (c, rest) => 
  43.         if c = #" " orelse c = #"\t" orelse c = #"\n" then
  44.         skipWS {getc=getc} rest
  45.         else source;
  46.  
  47. fun escape getc source = 
  48.     let fun skipform src = 
  49.     case getc (skipWS {getc=getc} src) of
  50.         NONE              => NONE
  51.       | SOME(#"\\", rest) => escape getc rest
  52.     in
  53.     case getc source of
  54.         NONE              => NONE
  55.       | SOME(#"n", rest)  => SOME(#"\n", rest)
  56.       | SOME(#"t", rest)  => SOME(#"\t", rest)
  57.       | SOME(#"\"", rest) => SOME(#"\"", rest)
  58.       | SOME(#"\\", rest) => SOME(#"\\", rest)
  59.       | SOME(#" ", rest)  => skipform rest
  60.       | SOME(#"\n", rest) => skipform rest
  61.       | SOME(#"\t", rest) => skipform rest
  62.       | SOME(#"^", rest)  => 
  63.         (case getc rest of
  64.              NONE => NONE
  65.            | SOME(c, rest) => 
  66.              if #"@" <= c andalso c <= #"_" then
  67.                  SOME(Char.chr(Char.ord c - 64), rest)
  68.              else
  69.                  NONE)
  70.       | _     => 
  71.         (case getndig getc 3 0 source of
  72.              NONE             => NONE
  73.            | SOME(code, rest) => 
  74.              if code > Char.maxOrd then NONE
  75.              else SOME(Char.chr code, rest))
  76.     end
  77.  
  78.  
  79. fun fromChar c = 
  80.     let val s = fromchr_ c
  81.     in String.substring(s, 2, String.size s - 3) end
  82. fun fromString s = 
  83.     let val ss = fromstr_ s
  84.     in String.substring(ss, 1, String.size ss - 2) end
  85.  
  86. fun scantoChar {getc} source =
  87.     case getc source of
  88.     NONE              => NONE
  89.       | SOME(#"\\", rest) => escape getc rest
  90.       | SOME(#"\"", rest) => NONE
  91.       | res               => res;
  92.         
  93. fun scantoString {getc} source =
  94.     let fun h src res = 
  95.          case scantoChar {getc=getc} src of 
  96.          NONE          => SOME(String.implode(List.rev res), src)
  97.            | SOME(c, rest) => h rest (c :: res)
  98.     in h source [] end;
  99.  
  100. fun toChar s   = scanString scantoChar s
  101. fun toString s = scanString scantoString s
  102.  
  103. local 
  104.     prim_val mkstring_ : int -> string                 = 1 "create_string";
  105.     prim_val fill_     : string -> int -> int -> char -> unit 
  106.                                                        = 4 "fill_string";
  107.     prim_val blit_     : string -> int -> string -> int -> int -> unit 
  108.                                                        = 5 "blit_string";
  109. in
  110.     fun padLeft c n s = 
  111.     let val ssize = size s
  112.     in if n <= ssize then s
  113.        else let val res = mkstring_ n 
  114.         in
  115.             fill_ res 0 (n - ssize) c;
  116.             blit_ s 0 res (n - ssize) ssize;
  117.             res
  118.         end
  119.     end;
  120.          
  121.     fun padRight c n s = 
  122.     let val ssize = size s
  123.     in if n <= ssize then s
  124.        else let val res = mkstring_ n 
  125.         in
  126.             blit_ s 0 res 0 ssize;
  127.             fill_ res ssize (n - ssize) c;
  128.             res
  129.         end
  130.     end;
  131. end
  132. end
  133.